home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / C / READ.C < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-24  |  3.0 KB  |  115 lines
  1. /* READ.C
  2.  ************************************************************************
  3.  *                                    *
  4.  *        PC Scheme/Geneva 4.00 Borland C code            *
  5.  *                                    *
  6.  * (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7.  * (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8.  *                                    *
  9.  *----------------------------------------------------------------------*
  10.  *                                    *
  11.  *        Scheme Expression Reading                *
  12.  *                                    *
  13.  *----------------------------------------------------------------------*
  14.  *                                    *
  15.  * Created by: Mark E. Meyer        Date: Jun 1984            *
  16.  * Revision history:                            *
  17.  * - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  18.  *                                    *
  19.  *                    ``In nomine omnipotentii dei''    *
  20.  ************************************************************************/
  21.  
  22. #include    "scheme.h"
  23.  
  24. extern char    decpoint;    /* Current decimal point character */
  25.  
  26. #define ATOM 0            /* Codes returned by FINDTASK function */
  27. #define NIL 1
  28. #define LPAREN 2
  29. #define RPAREN 3
  30. #define QUOTE 4
  31. #define DOT 5
  32.  
  33. #define DS 0            /* Register array subscripts */
  34. #define PG 1
  35.  
  36. /****************************************************************/
  37. /* SCANFLO(s,flo,base)                        */
  38. /* The string S, which ends in a control char, holds a        */
  39. /* representation of a floating-point number.    The value of    */
  40. /* this number is stored in *FLO.                */
  41. /****************************************************************/
  42. void    scanflo(char *s, double *flo, int base)
  43. {
  44.     int        i = 0;
  45.     int        neg = 0;
  46.     int        x = 0;
  47.     double        place;
  48.  
  49.     switch (*s) {
  50.     case '-':
  51.         neg = -1;
  52.     case '+':
  53.         i++;
  54.         break;
  55.     default:
  56.         break;
  57.     }
  58.     while (s[i] == '#')
  59.         i += 2;
  60.     *flo = 0.0;
  61.     while (isdig(s[i], base)) {
  62.         *flo = (*flo * base) + digval(s[i++]);
  63.     }
  64.     if (!(s[i] == decpoint))
  65.         goto EXPON;
  66. POINT:
  67.     i++;
  68.     place = 1.0;
  69.     while (isdig(s[i], base)) {
  70.         place /= base;
  71.         *flo += place * digval(s[i++]);
  72.     }
  73.     if (s[i] < ' ')
  74.         goto GOTFLO;
  75. EXPON:
  76.     i++;
  77.     if (s[i] == '-') {
  78.         i++;
  79.         place = 1.0 / base;
  80.     } else
  81.         place = base;
  82.     while (isdigit(s[i]))
  83.         x = (x * 10) + digval(s[i++]);
  84.     while (x) {
  85.         if (x != (x >> 1) << 1)
  86.             *flo *= place;
  87.         if (place < 1.0e153)
  88.             place *= place;
  89.         x >>= 1;
  90.     }
  91. GOTFLO:
  92.     if (neg)
  93.         *flo = -*flo;
  94. }
  95.  
  96.  
  97. /****************************************************************/
  98. /* ALLOC_INT(reg,buf)                        */
  99. /* This allocates an integer, either a fixnum or a        */
  100. /* bignum, depending on the size of the integer, i.e., if    */
  101. /* the absolute value < 16384, then a fixnum is allocated.    */
  102. /* The value is read from BUF.                    */
  103. /****************************************************************/
  104. void    alloc_int( REGPTR reg, BIGDATA *buf )
  105. {
  106.     while( buf->len > 1 && buf->data[buf->len-1] == 0 )
  107.         buf->len--;
  108.     if( buf->len == 1 && buf->data[0] <= 0x7fff + (buf->sign & 1) )
  109.         alloc_fixnum( reg, (buf->sign & 1) ? -buf->data[0] : buf->data[0] );
  110.     else {
  111.         alloc_block( reg, BIGTYPE, 2 * buf->len + 1 );
  112.         toblock( reg, 3, &(buf->sign), 2 * buf->len + 1 );
  113.     }
  114. }
  115.